perm filename FORSAM.F4[STR,LCS] blob
sn#339455 filedate 1978-03-09 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 CFORS3 FORTRAN UNIT GENERATOR ROUTINE
C00015 ENDMK
Cā;
CFORS3 FORTRAN UNIT GENERATOR ROUTINE
C *** MUSIC V ***
SUBROUTINEFORSAM
DIMENSION L(8),M(8)
CC DIMENSION I(15000),P(100),IP(20),L(8),M(8)
COMMON I(1)/P/ P(1)/PARM/IP(1)
CC COMMONI,P/PARM/IP
EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(
2L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(RN1,IRN1),(RN3,IRN3),(RN,I
3RN)
CC***** DATA IMULT/Z5EECE66D/
DATA IIIRD/976545367/
SFI=1./FLOAT(IP(12))
SFF=1./FLOAT(IP(15))
SFID=FLOAT(IP(12))
SFXX=FLOAT(IP(12))/FLOAT(IP(15))
XNFUN=IP(6)-1
C COMMON INITIALIZATION OF GENERATORS
N1=I(6)+2
N2=I(N1-1)-1
DO 204J1=N1,N2
J2=J1-N1+1
IF(I(J1))200,201,201
200 L(J2)=-I(J1)
M(J2)=1
GO TO 204
201 M(J2)=0
IF(I(J1)-262144)202,202,203
C***** WHAT DOES THE BIG NUMBER DO?????
202 L(J2)=I(J1)+I(3)-1
GO TO 204
203 L(J2)=I(J1)-262144
204 CONTINUE
NSAM=I(5)
N3=I(N1-2)
NGEN= N3 -100
GO TO (101,102,103,104,105,106,107,108,109,110,111,112),NGEN
112 RETURN
C UNIT GENERATORS
C OUTPUT BOX
101 IF(M1)260,260,261
260 IN1=I(L1)
261 CONTINUE
DO 270J3=1,NSAM
IF(M1)265,265,264
264 J4=L1+J3-1
IN1=I(J4)
265 J5=L2+J3-1
I(J5)=IN1+I(J5)
270 CONTINUE
RETURN
C OSCILLATOR
102 SUM=FLOAT(I(L5))*SFI
IF(M1)280,280,281
280 AMP=FLOAT(I(L1))*SFI
281 IF(M2)282,282,283
282 FREQ=FLOAT(I(L2))*SFI
283 CONTINUE
DO 293J3=1,NSAM
J4=INT(SUM)+L4
F=FLOAT(I(J4))
IF(M2)285,285,286
285 SUM=SUM+FREQ
GO TO 290
286 J4=L2+J3-1
SUM=SUM+FLOAT(I(J4))*SFI
CC 290 IF(SUM-XNFUN)288,287,287
290 IF(SUM.GE.XNFUN)GO TO 287
CC 287 SUM=SUM-XNFUN
IF(SUM.LT.0.0)GO TO 289
288 J5=L3+J3-1
IF(M1)291,291,292
291 I(J5)=IFIX(AMP*F*SFXX)
GO TO 293
C**********
287 SUM=SUM-XNFUN
GO TO 288
289 SUM=SUM+XNFUN
GO TO 288
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
292 J6=L1+J3-1
I(J5)=IFIX(FLOAT(I(J6))*F*SFF)
293 CONTINUE
I(L5)=IFIX(SUM*SFID)
RETURN
C ADD TWO BOX
103 IF(M1)250,250,251
250 IN1=I(L1)
251 IF(M2)252,252,253
252 IN2=I(L2)
253 DO 258J3=1,NSAM
IF(M1)255,255,254
254 J4=L1+J3-1
IN1=I(J4)
255 IF(M2) 257,257,256
256 J5=L2+J3-1
IN2=I(J5)
257 J6=L3+J3-1
I(J6)=IN1+IN2
258 CONTINUE
RETURN
C RANDOM INTERPOLATING GENERATOR
104 SUM=FLOAT(I(L4))*SFI
IF(M1)310,310,311
310 XIN1=FLOAT(I(L1))*SFI
311 IF(M2)312,312,313
312 XIN2=FLOAT(I(L2))*SFI
313 IRN1=I(L5)
IRN3=I(L6)
DO 340J3=1,NSAM
IF(M1)316,316,315
315 J4=L1+J3-1
XIN1=FLOAT(I(J4))*SFI
316 IF(M2)318,318,317
317 J5=L2+J3-1
XIN2=FLOAT(I(J5))*SFI
318 IF(SUM-XNFUN)320,319,319
319 SUM=SUM-XNFUN
I(7)=IABS (I(7)*IMULT)
RN4=(2.*FLOAT(I(7))*SFF-1.)
RN2=RN4-RN3
RN1=RN3
RN3=RN4
GO TO 321
320 RN2=RN3-RN1
321 J7=L3+J3-1
I(J7)=XIN1*(RN1+(RN2*SUM)/XNFUN)*SFID
SUM=SUM+XIN2
340 CONTINUE
I(L4)=IFIX(SUM*SFID)
I(L5)=IRN1
I(L6)=IRN3
RETURN
C ENVELOPE GENERATOR
105 SUM=FLOAT(I(L7))*SFI
IF(M1)380,380,381
380 XIN1=FLOAT(I(L1))*SFI
381 IF(M4)382,382,383
382 XIN4=FLOAT(I(L4))*SFI
383 IF(M5)384,384,385
384 XIN5=FLOAT(I(L5))*SFI
385 IF(M6)386,386,387
386 XIN6=FLOAT(I(L6))*SFI
387 X1=XNFUN/4.
X2=2.*X1
X3=3.*X1
DO 403 J3=1,NSAM
J4=INT(SUM)+L2
F=FLOAT(I(J4))
IF(M1)405,405,404
404 J8=L1+J3-1
XIN1=FLOAT(I(J8))*SFI
405 IF(SUM-XNFUN)389,388,388
388 SUM=SUM-XNFUN
389 IF(SUM-X1)390,390,393
390 IF(M4)392,392,391
391 J4=L4+J3-1
XIN4=FLOAT(I(J4))*SFI
392 SUM=SUM+XIN4
GO TO 402
393 IF(SUM-X2)394,394,397
394 IF(M5)396,396,395
395 J5=L5+J3-1
XIN5=FLOAT(I(J5))*SFI
396 SUM=SUM+XIN5
GO TO 402
397 IF(M6)400,400,399
399 J6=L6+J3-1
XIN6=FLOAT(I(J6))*SFI
400 SUM=SUM+XIN6
402 J7=L3+J3-1
I(J7)=IFIX(XIN1*F*SFXX)
403 CONTINUE
I(L7)=IFIX(SUM*SFID)
RETURN
C STEREO OUTPUT BOX
106 IF(M1)500,500,501
500 IN1=I(L1)
501 IF(M2)502,502,503
502 IN2=I(L2)
503 NSSAM=2*NSAM
C 6/29/70 L.C.SMITH
ICT=0
DO 510J3=1,NSSAM,2
IF(M1)505,505,504
CC*** 504 J4=L1+J3-1
504 J4=L1+ICT
IN1=I(J4)
505 J5=L3+J3-1
I(J5)=IN1+I(J5)
IF(M2)507,507,506
CC*** 506 J4=L2+J3-1
506 J4=L2+ICT
IN2=I(J4)
507 J5=L3+J3
I(J5)=IN2+I(J5)
510 CONTINUE
RETURN
C ADD 3 BOX
107 IF(M1)750,750,751
750 IN1=I(L1)
751 IF(M2)752,752,753
752 IN2=I(L2)
753 IF(M3)754,754,755
754 IN3=I(L3)
755 DO 780J3=1,NSAM
IF(M1)757,757,756
756 J4=L1+J3-1
IN1=I(J4)
757 IF(M2)759,759,758
758 J5=L2+J3-1
IN2=I(J5)
759 IF(M3)761,761,760
760 J6=L3+J3-1
IN3=I(J6)
761 J7=L4+J3-1
I(J7)=IN1+IN2+IN3
780 CONTINUE
RETURN
C ADD 4 BOX
108 IF(M1)850,850,851
850 IN1=I(L1)
851 IF(M2)852,852,853
852 IN2=I(L2)
853 IF(M3)854,854,855
854 IN3=I(L3)
855 IF(M4)856,856,857
856 IN4=I(L4)
857 DO 880J3=1,NSAM
IF(M1)859,859,858
858 J4=L1+J3-1
IN1=I(J4)
859 IF(M2)861,861,860
860 J5=L2+J3-1
IN2=I(J5)
861 IF(M3)863,863,862
862 J6=L3+J3-1
IN3=I(J6)
863 IF(M4)865,865,864
864 J7=L4+J3-1
IN4=I(J7)
865 J8=L5+J3-1
I(J8)=IN1+IN2+IN3+IN4
880 CONTINUE
RETURN
C MULTIPLIER
109 IF(M1)900,900,901
900 XIN1=FLOAT(I(L1))*SFI
901 IF(M2)902,902,903
902 XIN2=FLOAT(I(L2))*SFI
903 DO 908J3=1,NSAM
IF(M1)905,905,904
904 J4=L1+J3-1
XIN1=FLOAT(I(J4))*SFI
905 IF(M2)907,907,906
906 J5=L2+J3-1
XIN2=FLOAT(I(J5))*SFI
907 J6=L3+J3-1
I(J6)=XIN1*XIN2*SFID
908 CONTINUE
RETURN
C SET NEW FUNCTION IN OSC OR ENV
110 ILOC=N1+6
IF(I(N1+1).EQ.105) ILOC=N1+4
IN1=I(3)+I(N1)-1
IIN1=I(IN1)/IP(12)
IF(IIN1)960,960,955
955 I(ILOC)=-IP(2)-(IIN1-1)*IP(6)
960 RETURN
C RANDOM AND HOLD GENERATOR
111 SUM=FLOAT(I(L4))*SFI
IF(M1)910,910,911
910 XIN1=FLOAT(I(L1))*SFI
911 IF(M2)912,912,913
912 XIN2=FLOAT(I(L2))*SFI
913 IRN=I(L5)
DO 940J3=1,NSAM
IF(M1)916,916,915
915 J4=L1+J3-1
XIN1=FLOAT(I(J4))*SFI
916 IF(M2)918,918,917
917 J5=L2+J3-1
XIN2=FLOAT(I(J5))*SFI
918 IF(SUM-XNFUN)920,919,919
919 SUM=SUM-XNFUN
I(7)=IABS (I(7)*IMULT)
RN=(2.*FLOAT(I(7))*SFF-1.)
920 J7=L3+J3-1
I(J7)=XIN1*RN*SFID
SUM=SUM+XIN2
940 CONTINUE
I(L4)=IFIX(SUM*SFID)
I(L5)=IRN
RETURN
END